home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / gle / eval.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-29  |  13.2 KB  |  541 lines
  1. /*---------------------------------------------------------------------------*/
  2. #include "all.h"
  3. #include <math.h>
  4. #include <time.h>
  5. #include "mygraph.h"
  6. #include "rgb.h"
  7. colortyp colvar;
  8. #define true (!false)
  9. #define false 0
  10. char *eval_str();
  11. int var_getstr(int varnum,char *s);
  12. int pass_marker(char *s);
  13. int f_eof(int chn);
  14. /*---------------------------------------------------------------------------*/
  15. /* bin = 10..29, binstr = 30..49, fn= 60...139, userfn=200..nnn */
  16. /* pcode:,  1=exp,len  2=float,val 3=var,long 4,string_var, 5=string,.../0 */
  17. /*---------------------------------------------------------------------------*/
  18. /* Input is exp-pcode, output is number or string */
  19.  
  20. char *binop[] = { "", "+", "-", "*", "/", "^", "=", "<", "<=", ">"
  21.             , ">=", "<>", ".AND.", ".OR." };
  22.  
  23. struct keyw { char *word; int index; int ret,np,p[5]; } ;
  24. extern struct keyw keywfn[] ;
  25.  
  26. double stk[60];
  27. int stk_var[100];
  28. char *stk_str[100];
  29. int stk_strlen[100];
  30. char sbuf[512];
  31. char sbuf2[112];
  32. int nstk=0;
  33. extern int gle_debug;
  34. #define dbg if ((gle_debug & 2)>0)
  35.  
  36. eval(long *pcode,int *cp,double *oval,char *ostr,int *otyp)
  37. {
  38.         /* a pointer to the pcode to execute         */
  39.         /* Current point in this line of pcode         */
  40.         /* place to put result number             */
  41.         /* place to put result string             */
  42.         /* place to put result type, 1=num, 2=str     */
  43.     union {double d; long l[1];} both;
  44.     char *ss2,*ss;
  45.     int plen,i,j,l,c,cde;
  46.     time_t today;
  47.     double x1,y1,x2,y2;
  48.     double xx,yy,zz;
  49.     dbg gprint("%%EXP-START, Current point in eval %d %d \n",*cp,(int) *(pcode+(*cp)));
  50.     dbg for (i=0;i<10;i++) gprint("%ld ",*(pcode+i));
  51.     dbg gprint("\n");
  52.     dbg debug_polish(pcode,cp);
  53.     if (*(pcode+(*cp))==8) {    /*  Single constant  */
  54.         both.l[0] = *(pcode+ ++(*cp));
  55.         both.l[1] = 0;
  56.         dbg gprint("Constant %ld \n",both.l[0]);
  57.         memcpy(oval,&both.d,sizeof(both.d));
  58.         memcpy(&both.d,oval,sizeof(both.d));
  59.         ++(*cp);
  60.         return;
  61.     }
  62.  
  63.     if (*(pcode+(*cp)++)!=1) {
  64.         gprint("PCODE, Expecting expression, v=%ld cp=%d \n",*(pcode+(--*(cp))),*cp);
  65.         return;
  66.     }
  67.     plen = *(pcode+*(cp));
  68.     dbg gprint(" plen = %d ",plen);
  69.     if (plen>1000) gprint("Expression is suspiciously long %d \n",plen);
  70.     for (c=(*cp)+1;c<=(plen+ *cp);c++) {
  71.       cde = *(pcode+c);
  72.       dbg gprint(" c=%d ",cde);
  73.       switch (*(pcode+c)) {
  74.         /* Special commands 1..9  ------------------------------- */
  75.         case 1:    /* Start of another expression (function param) */
  76.             c++;    /* skip over exp length */
  77.             break;
  78.         case 2: /* Floating point number follows */
  79.             *otyp = 1;
  80.             both.l[0] = *(pcode+(++c));
  81.             both.l[1] = *(pcode+(++c));
  82.             stk[++nstk] =  both.d;
  83.              dbg gprint("Got float %f %d %f \n",stk[nstk],nstk,*(pcode+(c)));
  84.             break;
  85.         case 3: /* Floating_point variable number follows */
  86.             *otyp = 1;
  87.             var_get(*(pcode+(++c)),&xx);
  88.             dbg gprint("Got variable value %ld %f \n",*(pcode+(c)),xx);
  89.             stk[++nstk] = xx;
  90.             break;
  91.         case 4: /* string variable number follows */
  92.             *otyp = 2;
  93.             var_getstr(*(pcode+(++c)),sbuf); nstk++;
  94.             if (stk_str[nstk]!=NULL)  myfree(stk_str[nstk]);
  95.             stk_str[nstk] = sdup(sbuf);
  96.              break;
  97.         case 5: /* Null terminated string follows (long alligned) */
  98.             *otyp = 2;
  99.             c++;nstk++;
  100.             strcpy(sbuf,eval_str(pcode,&c));
  101.             if (stk_str[nstk]!=NULL)  myfree(stk_str[nstk]);
  102.             stk_str[nstk] = sdup(sbuf);
  103.             break;
  104.         /* Numeric Binary operators 10..29 ----------------------- */
  105.         case 11:  /* + */
  106.             nstk--;
  107.             stk[nstk] = stk[nstk+1] + stk[nstk];
  108.             break;
  109.         case 12:  /* - */
  110.             stk[nstk-1] = stk[nstk-1] - stk[nstk];
  111.             nstk--;
  112.             break;
  113.         case 13:  /* * */
  114.             stk[nstk-1] = stk[nstk-1] * stk[nstk];
  115.             nstk--;
  116.             break;
  117.         case 14:  /* / */
  118.             if (stk[nstk]==0) {
  119.                 gprint("Divide by zero %g %g \n",
  120.                     stk[nstk-1],stk[nstk]);
  121.             } else {
  122.                 stk[nstk-1] = stk[nstk-1] / stk[nstk];
  123.             }
  124.             nstk--;
  125.             break;
  126.         case 15:  /* ^ */
  127.             stk[nstk-1] = pow(stk[nstk-1],stk[nstk]);
  128.             nstk--;
  129.             break;
  130.         case 16:  /* = */
  131.             nstk--;
  132.             if (stk[nstk] == stk[nstk+1]) stk[nstk]=true;
  133.             else stk[nstk]=false;
  134.             break;
  135.         case 17:  /* <   */
  136.             nstk--;
  137.             if (stk[nstk] < stk[nstk+1]) stk[nstk]=true;
  138.             else stk[nstk]=false;
  139.             break;
  140.         case 18:  /* <=  */
  141.             nstk--;
  142.             if (stk[nstk] <= stk[nstk+1]) stk[nstk]=true;
  143.             else stk[nstk]=false;
  144.             break;
  145.         case 19:  /* >   */
  146.             nstk--;
  147.             if (stk[nstk] > stk[nstk+1]) stk[nstk]=true;
  148.             else stk[nstk]=false;
  149.             break;
  150.         case 20:  /* >=  */
  151.             nstk--;
  152.             if (stk[nstk] >= stk[nstk+1]) stk[nstk]=true;
  153.             else stk[nstk]=false;
  154.             break;
  155.         case 21:  /*  <>  */
  156.             nstk--;
  157.             if (stk[nstk] != stk[nstk+1]) stk[nstk]=true;
  158.             else stk[nstk]=false;
  159.             break;
  160.         case 22:  /* .AND.  */
  161.             nstk--;
  162.             if (stk[nstk] && stk[nstk+1]) stk[nstk]=true;
  163.             else stk[nstk]=false;
  164.             break;
  165.         case 23:  /* .OR.   */
  166.             nstk--;
  167.             if (stk[nstk] || stk[nstk+1]) stk[nstk]=true;
  168.             else stk[nstk]=false;
  169.             break;
  170.         /* String Binary operators 30..49 ----------------------- */
  171.         case 31:  /* + */
  172.             *otyp = 2;
  173.             nstk--;
  174.             if (stk_str[nstk]!=NULL) strcpy(sbuf,stk_str[nstk]);
  175.             if (stk_str[nstk+1]!=NULL) strcat(sbuf,stk_str[nstk+1]);
  176.             if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
  177.             stk_str[nstk] = sdup(sbuf);
  178.             break;
  179.         case 32:  /* - */
  180.             break;
  181.         case 33:  /* * */
  182.             break;
  183.         case 34:  /* / */
  184.             break;
  185.         case 35:  /* ^ */
  186.             break;
  187.         case 36:  /* = */
  188.             *otyp = 1;
  189.             nstk--;
  190.             if (strcmp(stk_str[nstk],stk_str[nstk+1])==0)
  191.                 stk[nstk]=true;
  192.             else
  193.                 stk[nstk]=false;
  194.             break;
  195.         case 37:  /* <   */
  196.             break;
  197.         case 38:  /* <=  */
  198.             break;
  199.         case 39:  /* >   */
  200.             break;
  201.         case 40:  /* >=  */
  202.             break;
  203.         case 41:  /* .AND.  */
  204.             break;
  205.         case 42:  /* .OR.   */
  206.             break;
  207.  
  208.         /* Built in functions 60..199 ----------------------------- */
  209.         case 61: /* unary plus */
  210.             break;
  211.         case 62: /* unary minus */
  212.             stk[nstk] = -stk[nstk];
  213.             break;
  214.         case 63: /* abs */
  215.             stk[nstk] = fabs(stk[nstk]);
  216.             break;
  217.         case 64: /* atn */
  218.             stk[nstk] = atan(stk[nstk]);
  219.             break;
  220.         case 113: /* ACOS */
  221.             stk[nstk] = acos(stk[nstk]);
  222.             break;
  223.         case 114: /* ASIN */
  224.             stk[nstk] = asin(stk[nstk]);
  225.             break;
  226.         case 65: /* cos */
  227.             stk[nstk] = cos(stk[nstk]);
  228.             break;
  229.         case 66: /* date$ */
  230.             *otyp = 2;
  231.             time(&today);
  232.             strcpy(sbuf2,ctime(&today));
  233.             strcpy(sbuf,sbuf2);
  234.             strcpy(sbuf+11,sbuf2+20);
  235.             sbuf[strlen(sbuf)-1] = 0;
  236.             setdstr(&stk_str[++nstk],sbuf);
  237.             break;
  238.         case 111: /* device$ */
  239.             *otyp = 2;
  240.             g_get_type(sbuf2);
  241.             setdstr(&stk_str[++nstk],sbuf2);
  242.             break;
  243.         case 115: /* feof(chan) */
  244.             stk[nstk] = f_eof((int) stk[nstk]);
  245.             break;
  246.         case 67: /* exp */
  247.             stk[nstk] = exp(stk[nstk]);
  248.             break;
  249.         case 68: /* fix*/
  250.             stk[nstk] = floor(stk[nstk]);
  251.             break;
  252.         case 69: /* height */
  253.             break;
  254.         case 70: /* long */
  255.             break;
  256.         case 112: /* CHR$() */
  257.             *otyp = 2;
  258.             sprintf(sbuf,"%c",(int) stk[nstk]);
  259.             setdstr(&stk_str[nstk],sbuf);
  260.             break;
  261.         case 71: /* left$ */
  262.             *otyp = 2;
  263.             ncpy(sbuf,stk_str[nstk-1],(int) stk[nstk]);
  264.             setdstr(&stk_str[--nstk],sbuf);
  265.             break;
  266.         case 72: /* len */
  267.             *otyp = 1;
  268.             stk[nstk] = strlen(stk_str[nstk]);
  269.             break;
  270.         case 73: /* log */
  271.             stk[nstk] = log(stk[nstk]);
  272.             break;
  273.         case 74: /* log10 */
  274.             stk[nstk] = log10(stk[nstk]);
  275.             break;
  276.         case 75: /* not */
  277.             break;
  278.         case 76: /* num$ */
  279.             *otyp = 2;
  280.             sprintf(sbuf,"%g ",stk[nstk]);
  281.             if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
  282.             stk_str[nstk] = sdup(sbuf);
  283.             break;
  284.         case 77: /* num1$ */
  285.             *otyp = 2;
  286.             sprintf(sbuf,"%g",stk[nstk]);
  287.             if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
  288.             stk_str[nstk] = sdup(sbuf);
  289.             break;
  290.         case 78: /* pageheight */
  291.             break;
  292.         case 79: /* pagewidth */
  293.             break;
  294.         case 80: /* pos */
  295.             *otyp = 1;
  296.             i = stk[nstk];
  297.             if (i<=0) i = 1;
  298.             ss = stk_str[nstk-2];
  299.             ss2 = strstr(ss+i-1,stk_str[nstk-1]);
  300.             if (ss2!=NULL)     i = ss2-ss+1;
  301.             else         i = 0;
  302.             nstk -= 2;
  303.             stk[nstk] = i;
  304.             break;
  305.         case 81: /* right$ */
  306.             *otyp = 2;
  307.             strcpy(sbuf,stk_str[nstk-1] + (int) stk[nstk] - 1);
  308.             setdstr(&stk_str[--nstk],sbuf);
  309.             break;
  310.         case 82: /* rnd */
  311.             break;
  312.         case 83: /* seg$ */
  313.             *otyp = 2;
  314.             strcpy(sbuf,stk_str[nstk-2] + (int) stk[nstk-1] - 1);
  315.             ncpy(sbuf2,sbuf,(int) stk[nstk] -  stk[nstk-1] + 1);
  316.             nstk-=2;
  317.             setdstr(&stk_str[nstk],sbuf2);
  318.             break;
  319.         case 84: /* sgn */
  320.             if (stk[nstk]>=0) stk[nstk] = 1;
  321.             else stk[nstk] = -1;
  322.             break;
  323.         case 85: /* sin */
  324.             stk[nstk] = sin(stk[nstk]);
  325.             break;
  326.         case 86: /* sqr */
  327.             stk[nstk] = stk[nstk] * stk[nstk];
  328.             break;
  329.         case 87: /* sqrt */
  330.             stk[nstk] = sqrt(stk[nstk]);
  331.             break;
  332.         case 88: /* tan */
  333.             stk[nstk] = tan(stk[nstk]);
  334.             break;
  335.         case 89: /* tdepth */
  336.             *otyp = 1;
  337.             g_get_xy(&xx,&yy);
  338.             g_measure(stk_str[nstk],&x1,&x2,&y2,&y1);
  339.             stk[nstk] = y1;
  340.             break;
  341.         case 90: /* theight */
  342.             *otyp = 1;
  343.             g_get_xy(&xx,&yy);
  344.             g_measure(stk_str[nstk],&x1,&x2,&y2,&y1);
  345.             stk[nstk] = y2;
  346.             break;
  347.         case 91: /* time$ */
  348.             *otyp = 2;
  349.             time(&today);
  350.             ncpy(sbuf,ctime(&today)+11,9);
  351.             setdstr(&stk_str[++nstk],sbuf);
  352.             break;
  353.         case 92: /* twidth */
  354.             *otyp = 1;
  355.             g_measure(stk_str[nstk],&x1,&x2,&y1,&y2);
  356.             stk[nstk] = x2-x1;
  357.             break;
  358.         case 93: /* val */
  359.             break;
  360.         case 94: /* width */
  361.             break;
  362.         case 95: /* xend */
  363.             *otyp = 1;
  364.             stk[++nstk] = tex_xend();
  365.             break;
  366.         case 96: /* xgraph */
  367.             *otyp = 1;
  368.             stk[nstk] = graph_xgraph(stk[nstk]);
  369.             break;
  370.         case 97: /* xmax */
  371.             break;
  372.         case 98: /* xmin */
  373.             break;
  374.         case 99: /* xpos */
  375.             *otyp = 1;
  376.             g_get_xy(&xx,&yy);
  377.             stk[++nstk] = xx;
  378.             break;
  379.         case 100: /* yend */
  380.             stk[++nstk] = tex_yend();
  381.             *otyp = 1;
  382.             break;
  383.         case 101: /* ygraph */
  384.             stk[nstk] = graph_ygraph(stk[nstk]);
  385.             *otyp = 1;
  386.             break;
  387.         case 102: /* ymax */
  388.             break;
  389.         case 103: /* ymin */
  390.             break;
  391.         case 104: /* ypos */
  392.             g_get_xy(&xx,&yy);
  393.             *otyp = 1;
  394.             stk[++nstk] = yy;
  395.             break;
  396.         case 105: /* CVTGREY(.5) */
  397.             colvar.b[B_F] = 1;
  398.             colvar.b[B_R] = floor(stk[nstk]*255);
  399.             colvar.b[B_G] = colvar.b[B_R];
  400.             colvar.b[B_B] = colvar.b[B_R];
  401.             both.l[0] = colvar.l;
  402.             both.l[1] = 0;
  403.             memcpy(&stk[nstk],&both.d,sizeof(double));
  404.             break;
  405.         case 106: /* CVTINT(2) */
  406.             *otyp = 1;
  407.             both.l[0] = floor(stk[nstk]);
  408.             both.l[1] = 0;
  409.             memcpy(&stk[nstk],&both.d,sizeof(double));
  410.             break;
  411.         case 108: /* CVTMARKER(m$) */
  412.             *otyp = 1;
  413.             strupr(stk_str[nstk]);
  414.             both.l[0] = pass_marker(stk_str[nstk]);
  415.             both.l[1] = 0;
  416.             memcpy(&stk[nstk],&both.d,sizeof(double));
  417.             break;
  418.         case 110: /* CVTFONT(m$) */
  419.             *otyp = 1;
  420.             strupr(stk_str[nstk]);
  421.             both.l[0] = pass_font(stk_str[nstk]);
  422.             both.l[1] = 0;
  423.             memcpy(&stk[nstk],&both.d,sizeof(double));
  424.             break;
  425.         case 109: /* CVTCOLOR(c$) */
  426.             *otyp = 1;
  427.             strupr(stk_str[nstk]);
  428.             if (strchr(stk_str[nstk],'$')!=NULL) {
  429.                 gprint("Error in color name {%s} \n",stk_str[nstk]);
  430.                 break;
  431.             }
  432.             both.l[0] = pass_color(stk_str[nstk]);
  433.             both.l[1] = 0;
  434.             memcpy(&stk[nstk],&both.d,sizeof(double));
  435.             break;
  436.         case 107: /* CVTrGB(.4,.4,.2) */
  437.             colvar.b[B_F] = 1;
  438.             colvar.b[B_B] = floor(stk[nstk]*255);
  439.             colvar.b[B_G] = floor(stk[nstk-1]*255);
  440.             colvar.b[B_R] = floor(stk[nstk-2]*255);
  441.             nstk -= 2;
  442.             both.l[0] = colvar.l;
  443.             both.l[1] = 0;
  444.             memcpy(&both.l[0],&colvar.l,sizeof(long));
  445.             memcpy(&stk[nstk],&both.d,sizeof(double));
  446.             break;
  447.         /* User function 200..nnn , or error */
  448.         default:
  449.               /* Is it a user defined function */
  450.             if (*(pcode+c)>200)  {
  451.     /*            pass the address of some numbers */
  452.     /*            pass address of variables if possible*/
  453.                 sub_call(*(pcode+c)-200,stk,stk_str,&nstk,otyp);
  454.             }
  455.             else gprint("Unrecognised pcode exp prim %d at position=%d \n",*(pcode+c),c);
  456.             break;
  457.       }
  458.     }
  459.     dbg gprint("RESULT ISa ==== %d [1] %f   [nstk] %f \n",nstk,stk[1],stk[nstk]);
  460.     memcpy( oval,&(stk[nstk]),sizeof(double));
  461.     dbg gprint("RESULT ISb ==== %d [1] %f   [nstk] %f \n",nstk,stk[1],stk[nstk]);
  462.     dbg gprint("oval %g \n",*oval);
  463.     *ostr = '\0';
  464.     if (*otyp==2) if (stk_str[nstk]!=NULL) strcpy(ostr,stk_str[nstk]);
  465.     if (*otyp==2) dbg gprint("Evaluated string = {%s} \n",ostr);
  466.     nstk--;
  467.     if (nstk<0) {
  468.          gprint("Stack stuffed up in EVAL %d \n",nstk);
  469.         nstk = 0;
  470.     }
  471.     *cp = *cp + plen + 1;
  472. }
  473.  
  474. debug_polish(long *pcode,int *zcp)
  475. {
  476.     long *cp,cpval;
  477.     int plen,i,j,c,cde;
  478.     cpval = *zcp;
  479.     cp = &cpval;
  480.     if (*(pcode+(*cp)++)!=1) {
  481.         gprint("Expecting expression, v=%d \n",(int) *(pcode+--(*cp)) );
  482.         return;
  483.     }
  484.     plen = *(pcode+*(cp));
  485.     gprint("Expression length %d current point %d \n",plen,(int) *cp);
  486.     if (plen>1000) gprint("Expession is suspiciously long %d \n",plen);
  487.     for (c=(*cp)+1;(c-*cp)<=plen;c++) {
  488.       cde = *(pcode+c);
  489.     gprint("Code=%d ",cde);
  490.         if (cde==0) {
  491.             gprint("# ZERO \n");
  492.         } else if (cde==1) {
  493.             gprint("# Expression, length ??? \n");
  494.             c++;
  495.         } else if (cde==2) {
  496.             gprint("# Floating point number %8x \n",*(pcode+(++c)));
  497.             c++;    /* because it's a DOUBLE which is a quad word */
  498.         } else if (cde==3) {
  499.             gprint("# Variable \n");  c++;
  500.         } else if (cde==4) {
  501.             gprint("# String Variable \n"); c++;
  502.         } else if (cde==5) {
  503.             c++;
  504.             gprint("# String constant {%s} \n",eval_str(pcode,&c));
  505.         } else if (cde<29) {
  506.             gprint("# Binary operator {%s} \n",binop[cde-10]);
  507.         } else if (cde<49) {
  508.             gprint("# Binary string op {%s} \n",binop[cde-30]);
  509.         } else if (cde<200) {
  510.             gprint("# Built in function (with salt) {%s} \n",keywfn[cde-60].word);
  511.         } else {
  512.             gprint("# User defined function %d \n",cde);
  513.         }
  514.  
  515.     }
  516. }
  517.  
  518. char *eval_str(long *pcode,int *plen)
  519. {
  520.     char *s;
  521.     int sl;
  522.     s = (char *) (pcode+*plen);
  523.     sl = strlen(s)+1;
  524.     sl = ((sl + 3) & 0xfffc);
  525.     *plen = *plen + sl/4 - 1;
  526.     return s;
  527. }
  528.  
  529. setdstr(char **s,char *in)
  530. {
  531.     if (*s != NULL) myfree(*s);
  532.     *s = sdup(in);
  533. }
  534.  
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541.